perm filename LEFTFM.BLI[AI,LCS] blob sn#812719 filedate 1983-01-06 generic text, type T, neo UTF8
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
!  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

!COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1972, 1983
!AUTHOR: T.E. OSTEN

MODULE LFFM(STACK)= %SYNTAX%
BEGIN

GLOBAL BIND	LFFMV = 6↑24 + 0↑18 + 23;	!VERSION DATE: 21-Jul-81

%(

***** Begin Revision History *****

23	536	-----	ADD RCHAR TO ERR NAME PLIT

***** End Revision History *****

)%

REQUIRE  FMTLEX.BLI;



	STRUCTURE STRING[I]=@(.STRING+.I);
	STRUCTURE VECTX[I]=[I] .VECTX+.I;

	BIND VECTOR LEXNAME=PLIT(
%1%	PLIT'DOLLAR',
%2%	PLIT'LITSTRING',
%3%	PLIT'LPAREN',
%4%	PLIT'RPAREN',
%5%	PLIT'LINEND',
%6%	PLIT'PLUS',
%7%	PLIT'COMMA',
%8%	PLIT'MINUS',
%9%	PLIT'PERIOD',
%10%	PLIT'SLASH',
%11%	PLIT'COLON',
%12%	PLIT'CONSTANT',
%13%	PLIT'ACHAR',
%14%	PLIT'BCHAR',
%15%	PLIT'DCHAR',
%16%	PLIT'ECHAR',
%17%	PLIT'FCHAR',
%18%	PLIT'GCHAR',
%19%	PLIT'ICHAR',
%20%	PLIT'LCHAR',
%21%	PLIT'NCHAR',
%22%	PLIT'OCHAR',
%23%	PLIT'PCHAR',
%24%	PLIT'QCHAR',
%25%	PLIT'RCHAR',
%26%	PLIT'SCHAR',
%27%	PLIT'TCHAR',
%28%	PLIT'XCHAR',
%29%	PLIT'ZCHAR')-1;

BIND LEFTBUILD = 1;
REQUIRE	FRMBNF.BLI;		!BUILD FORMAT SYNTAX TABLES

REGISTER R;
MACHOP BLT=#251,TTCALL=#051;
BIND	VECTX	TYPE[0]=	BNFTBL<24,12>,
	VECTX	SUBP[0]=	BNFTBL<12,12>,
	VECTX	NUMBER[0]=	BNFTBL<0,12>,
	VECTX	LEXNUM[0]=	BNFTBL<12,6>;
FORWARD
	CERR,		%(S,N,L)= OUTPUT THE MESSAGE: "CONFLICT IN ",.METANAME[.S]," AT NODE ",.N,
			"WITH LEXEME" .L
			)%
	LEFT;		%(NODE,LAST,NAME)= CHECKS CONFLICTS WITH THE LEFT SON
			OF EACH NODE
			)%
EXTERNAL OUTZ,INIT,OCTOUT,DECOUT;
!******************************************************************************************************************
ROUTINE DEC(N)=
BEGIN
	LOCAL A;
	A←((.N MOD 10)+"0")↑29;
	N←.N/10;
	IF .N NEQ 0 THEN DEC(.N);
	TTCALL(3,A)
END;
!******************************************************************************************************************
ROUTINE CERR(S,N,L)=
%(-----------------------------------------------------------------------------------------------------------------
	S=	NUMBER OF THE METANAME STRING FROM THE LAST METASYMBOL
	N=	NODE AT WHICH CONFLICT OCCURED
	L=	LEXEME (OR TERMINAL) WHICH CONFLICTED
		(RESULT OF THE AND)
-----------------------------------------------------------------------------------------------------------------)%
BEGIN
	OUTZ(3,PLIT'%CONFLICT IN ');
	OUTZ(3,.METANAME[.S]);
	OUTZ(3,PLIT' AT NODE ');
	DECOUT(3,4,.N);
	OUTZ(3,PLIT' WITH ');
	VREG←FIRSTONE(.L);
	IF .VREG GTR LASTLEX THEN
	BEGIN
		VREG←.VREG-LASTLEX;
		OUTZ(3,PLIT'ACTION ?0');
		OUTZ(3,.ACTIONNAME[.VREG])
	END
	ELSE
	BEGIN
		OUTZ(3,PLIT'LEXEME ');
		OUTZ(3,.LEXNAME[.N])
	END;
	OUTZ(3,PLIT'%?M?J');
	R←.R+1
END;
!******************************************************************************************************************
BIND VECTOR TFIELD=PLIT(
%1%	PLIT'LEXEME',
%2%	PLIT'META',
%3%	PLIT'ALL',
%4%	PLIT'ONE',
%5%	PLIT'OPTION',
%6%	PLIT'LIST',
%7%	PLIT'REPEAT',
%8%	PLIT'ACTION',
%9%	PLIT'TERMINAL')-1;
OWN VECTOR LEFTLEX[LLSIZE],RIGHT,LEX,TRACE,START;
%(-----------------------------------------------------------------------------------------------------------------
	LEFTLEX=A BIT MASK OF THE LEXEMES COMPRISING THE LEFT SON OF EACH
		NODE IN THE BNF TABLE.
	RIGHT=	THE RIGHT BROTHER OF THE CURRENT SON OF AN ALL.
	LEX=	THE RESULT OF A LEXEME CONFLICT CHECK.
-----------------------------------------------------------------------------------------------------------------)%
ROUTINE TYPEOUT(N)=
!------------------------------------------------------------------------------------------------------------------
!	N= NODE TO BE TYPED
!
!TYPES: NODE(.N)= .TYPE, .SUBP, .NUMBER - .LEFTLEX
!------------------------------------------------------------------------------------------------------------------
BEGIN
	OUTZ(3,PLIT'NODE(');DECOUT(3,4,@N);OUTZ(3,PLIT')= ');
	OUTZ(3,.TFIELD[.TYPE[@N]]);
	OUTZ(3,PLIT', ');DECOUT(3,4,.SUBP[@N]);OUTZ(3,PLIT', ');
	IF .TYPE[@N] EQL LEXEME OR .TYPE[@N] EQL META THEN OUTZ(3,.METANAME[.NUMBER[@N]])
		ELSE DECOUT(3,4,.NUMBER[@N]);
	IF @LEFTLEX[@N] NEQ 0 THEN
	BEGIN
		OUTZ(3,PLIT'?M?J	');
		INCR I FROM -35 TO 0 DO
		BEGIN
			IF @LEFTLEX[@N]↑@I THEN OUTZ(3,PLIT'X') ELSE OUTZ(3,PLIT'O');
			IF (.I MOD 3) EQL 0 THEN OUTZ(3,PLIT' ')
		END;
	END;
	OUTZ(3,PLIT'?M?J')
END;
!******************************************************************************************************************
ROUTINE DECIN=
BEGIN
	REGISTER R1,R2;
	R1←R2←0;
	UNTIL (TTCALL(4,R1);.R1) EQL #015 OR .R1 EQL #012 DO
		R2←(.R2*10)+(.R1-"0");
	.R2
END;
!******************************************************************************************************************
ROUTINE LEFT(NODE,LAST,NAME)=
%(-----------------------------------------------------------------------------------------------------------------
	NODE=	THE CURRENT LOCATION IN THE BNF TABLE (BNFTBL).
	LAST=	THE RIGHT BROTHER OF THE CURRENT NODE AT THE LAST ALL.
		INITIALLY SET TO ZERO.
	NAME=	LOCATION IN THE METANAME TABLE OF THE LAST META.
-----------------------------------------------------------------------------------------------------------------)%
BEGIN
	LOCAL SON;
	IF .TRACE THEN (OUTZ(3,PLIT'BEGIN - ');TYPEOUT(@NODE));
	CASE .TYPE[@NODE] OF SET
%CASE 0%		EXITCASE;
%CASE 1-LEXEME%	LEFTLEX[@NODE]←1↑.LEXNUM[@NODE];
%CASE 2-META%	BEGIN
			IF .LEFTLEX[.SUBP[@NODE]] EQL 0 THEN
			BEGIN
				LEFTLEX[.SUBP[@NODE]]<35,1>←1;	!INDICATE NODE ALREADY SEEN
				LEFT(.SUBP[@NODE],@LAST,.NUMBER[@NODE]);
			END;
			LEFTLEX[@NODE]←@LEFTLEX[.SUBP[@NODE]];
		END;
%CASE 3-ALL%	BEGIN
			RIGHT←@LAST;
			SON←.SUBP[@NODE]+.NUMBER[@NODE]+1;
			WHILE (SON←.SON-1) GEQ .SUBP[@NODE] DO
			BEGIN
				LEFT(@SON,@RIGHT,@NAME);
				RIGHT←@SON
			END;
			WHILE (SON←.SON+1) LEQ .SUBP[@NODE]+.NUMBER[@NODE] DO
			BEGIN
				LEFTLEX[@NODE]←@LEFTLEX[@NODE] OR @LEFTLEX[@SON];
				IF .TYPE[@SON] NEQ OPTION THEN EXITLOOP	
			END;
			LEFTLEX[@NODE]←@LEFTLEX[@NODE] OR @LEFTLEX[@SON];
		END;
%CASE 4-ONE%	BEGIN
			SON←.SUBP[@NODE]+.NUMBER[@NODE]+1;
			WHILE (SON←.SON-1) GEQ .SUBP[@NODE] DO
			BEGIN
				LEFT(@SON,@LAST,@NAME);
				IF (LEX←@LEFTLEX[@NODE] AND @LEFTLEX[@SON] AND NOT 1↑35) NEQ 0
					THEN CERR(@NAME,@NODE,.LEX);
				LEFTLEX[@NODE]←@LEFTLEX[@NODE] OR @LEFTLEX[@SON];
			END;
		END;
%CASE 5-OPTION%	BEGIN
			SON←.SUBP[@NODE]+.NUMBER[@NODE]+1;
			WHILE (SON←.SON-1) GEQ .SUBP[@NODE] DO
			BEGIN
				LEFT(@SON,@LAST,@NAME);
				IF (LEX←@LEFTLEX[@NODE] AND @LEFTLEX[@SON] AND NOT 1↑35) NEQ 0
					THEN CERR(@NAME,@NODE,.LEX);
				LEFTLEX[@NODE]←@LEFTLEX[@NODE] OR @LEFTLEX[@SON];
			END;
		END;
%CASE 6-LIST%	BEGIN
			LEFT(.SUBP[@NODE],@LAST,@NAME);
			LEFTLEX[@NODE]←@LEFTLEX[.SUBP[@NODE]];
		END;
%CASE 7-REPEAT%	BEGIN
			LEFT(.SUBP[@NODE],@LAST,@NAME);
			LEFTLEX[@NODE]←@LEFTLEX[.SUBP[@NODE]];
			RIGHT←IF @LAST NEQ 0 THEN @LEFTLEX[@LAST] ELSE 0;
			IF (LEX←@LEFTLEX[@NODE] AND @RIGHT AND NOT 1↑35) NEQ 0
				 THEN CERR(@NAME,@NODE,@LEX);
		END;
%CASE 8-ACTION%	LEFTLEX[@NODE]←(1↑LASTLEX)↑.SUBP[@NODE];
%CASE 9-TERMINAL%	LEFTLEX[@NODE]←1↑.SUBP[@NODE]
		TES;
		IF .TRACE THEN (OUTZ(3,PLIT'  END - ');TYPEOUT(@NODE));
END;
OWN ANDS,ANDBRANCHES,ORS,ORBRANCHES;
LEFTLEX[0]←0;
R<18,18>←LEFTLEX[0];
R<0,18>←LEFTLEX[0]+1;
BLT(R,LEFTLEX[LLSIZE]);
!CLEAR LEFTLEX TABLE
INIT();	!3=DSK:LKAHD.BLI
R←0;
TTCALL(3,PLIT'?M?JSTART TRACE AT NODE #(0=NONE):');START←DECIN();
TTCALL(3,PLIT'?M?J');
TRACE←IF .START EQL 1 THEN 1 ELSE 0;
!------------------------------------------------------------------------------------------------------------------
!THE CODE THAT FOLLOWS ASSUMES THAT BNFTBL[1] IS THE BEGINNING OF THE
!DEFINITION OF THE FIRST METASYMBOL WHOSE NAME IS METANAME[1].
!------------------------------------------------------------------------------------------------------------------
LEFTLEX[1]<35,1>←1;	!INDICATES NODE ALREADY SEEN
LEFT(1,0,1);
ANDS←ANDBRANCHES←ORS←ORBRANCHES←0;
INCR I FROM 2 TO @BNFTBL-1 DO
BEGIN
	IF .START EQL .I THEN TRACE←1;
	IF .TYPE[@I] EQL META AND .LEFTLEX[@I]<0,35> EQL 0 THEN (LEFT(.I,0,.NUMBER[.I]);TRACE←0);
	IF .TYPE[@I] EQL ONE THEN (ORS←.ORS+1;ORBRANCHES←.ORBRANCHES+.NUMBER[@I]);
	IF .TYPE[@I] EQL ALL THEN (ANDS←.ANDS+1;ANDBRANCHES←.ANDBRANCHES+.NUMBER[@I]);
END;
INCR I FROM 2 TO @BNFTBL-1 DO
BEGIN
	IF .START EQL .I THEN TRACE←1;
	IF .LEFTLEX[@I]<0,35> EQL 0 THEN 
	BEGIN
		LEFT(.I,0,.NUMBER[.I]);
		TRACE←0;
		IF .TYPE[@I] EQL ONE THEN (ORS←.ORS+1;ORBRANCHES←.ORBRANCHES+.NUMBER[@I]);
		IF .TYPE[@I] EQL ALL THEN (ANDS←.ANDS+1;ANDBRANCHES←.ANDBRANCHES+.NUMBER[@I]);
	END
END;
DEC(.R);TTCALL(3,PLIT ' CONFLICTS EXIST?M?J');
TTCALL(3,PLIT'# OF ANDS: ');DEC(.ANDS);
TTCALL(3,PLIT'?M?J# OF AND BRANCHES: ');DEC(.ANDBRANCHES);
TTCALL(3,PLIT'?M?J# OF ORS: ');DEC(.ORS);
TTCALL(3,PLIT'?M?J# OF OR BRANCHES: ');DEC(.ORBRANCHES);TTCALL(3,PLIT'?M?J');
OUTZ(3,PLIT'?M?J!THE FOLLOWING TABLE WAS PRODUCED BY THE BLISS MODULE "LEFTFM.BLI"?M?J');
OUTZ(3,PLIT'?M?JBIND VECTOR LOOKAHEAD=PLIT(?M?J%');
INCR I FROM 1 TO @BNFTBL-1 DO
BEGIN
	DECOUT(3,4,@I);OUTZ(3,PLIT'%	#');OCTOUT(3,12,.LEFTLEX[@I]<0,35>);
	IF .LEFTLEX[@I]<0,30> LSS #100000 THEN OUTZ(3,PLIT',		%')
		ELSE OUTZ(3,PLIT',	%');
	OUTZ(3,.TFIELD[.TYPE[@I]]);OUTZ(3,PLIT', ');
	IF .TYPE[@I] EQL LEXEME THEN OCTOUT(3,4,.SUBP[@I]) ELSE DECOUT(3,4,.SUBP[@I]);
	OUTZ(3,PLIT', ');
	IF .TYPE[@I] EQL LEXEME OR .TYPE[@I] EQL META
		THEN OUTZ(3,.METANAME[.NUMBER[@I]])
		ELSE DECOUT(3,4,.NUMBER[@I]);
	OUTZ(3,PLIT'%?M?J%');
END;
DECOUT(3,4,@BNFTBL);
OUTZ(3,PLIT'%	0)-1;?M?J?L?0');
END
ELUDOM